home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / DBaldwin / htmllite.exe / demo_src / DEMOUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-24  |  21.3 KB  |  811 lines
  1. {$ifdef ver140} {Delphi 6}
  2. {$warn Symbol_Platform Off}   
  3. {$endif}
  4.  
  5. unit demounit;
  6. {A program to demonstrate the ThtmlLite component}
  7.  
  8. interface
  9.  
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, ExtCtrls, Menus, HTMLLite, StdCtrls, FontDlgL,
  13.   Clipbrd, Litesubs, Liteun2, ShellAPI,
  14.   LiteAbt, Submit, ImgForm, MMSystem, MPlayer;
  15.                                         
  16. const
  17.   MaxHistories = 6;  {size of History list}
  18. type
  19.   TForm1 = class(TForm)
  20.     OpenDialog: TOpenDialog;
  21.     MainMenu: TMainMenu;
  22.     Panel1: TPanel;
  23.     Panel2: TPanel;
  24.     Panel3: TPanel;
  25.     File1: TMenuItem;
  26.     Open: TMenuItem;
  27.     options1: TMenuItem;
  28.     ShowImages: TMenuItem;
  29.     Fonts: TMenuItem;
  30.     Edit1: TEdit;
  31.     ReloadButton: TButton;
  32.     BackButton: TButton;
  33.     FwdButton: TButton;
  34.     HistoryMenuItem: TMenuItem;
  35.     Exit1: TMenuItem;
  36.     N1: TMenuItem;
  37.     About1: TMenuItem;
  38.     Edit2: TMenuItem;
  39.     Find1: TMenuItem;
  40.     FindDialog: TFindDialog;
  41.     CopyItem: TMenuItem;
  42.     N2: TMenuItem;
  43.     SelectAllItem: TMenuItem;
  44.     OpenTextFile: TMenuItem;
  45.     OpenImageFile: TMenuItem;
  46.     PopupMenu: TPopupMenu;
  47.     CopyImageToClipboard: TMenuItem;
  48.     Viewimage: TMenuItem;
  49.     N3: TMenuItem;
  50.     OpenInNewWindow: TMenuItem;
  51.     MetaTimer: TTimer;
  52.     Viewer: ThtmlLite;
  53.     MediaPlayer: TMediaPlayer;
  54.     Timer1: TTimer;
  55.     procedure OpenFileClick(Sender: TObject);
  56.     procedure HotSpotChange(Sender: TObject; const URL: string);
  57.     procedure HotSpotClick(Sender: TObject; const URL: string;
  58.               var Handled: boolean);
  59.     procedure ShowImagesClick(Sender: TObject);
  60.     procedure ReloadButtonClick(Sender: TObject);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure FwdBackClick(Sender: TObject);
  63.     procedure HistoryClick(Sender: TObject);
  64.     procedure HistoryChange(Sender: TObject);
  65.     procedure Exit1Click(Sender: TObject);
  66.     procedure FontColorsClick(Sender: TObject);
  67.     procedure About1Click(Sender: TObject);
  68.     procedure FormShow(Sender: TObject);
  69.     procedure SubmitEvent(Sender: TObject; Const AnAction, Target, EncType, Method: String;
  70.       Results: TStringList);
  71.     procedure Find1Click(Sender: TObject);
  72.     procedure FindDialogFind(Sender: TObject);
  73.     procedure ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  74.     procedure CopyItemClick(Sender: TObject);
  75.     procedure Edit2Click(Sender: TObject);
  76.     procedure SelectAllItemClick(Sender: TObject);
  77.     procedure OpenTextFileClick(Sender: TObject);
  78.     procedure OpenImageFileClick(Sender: TObject);
  79.     procedure MediaPlayerNotify(Sender: TObject);
  80.     procedure SoundRequest(Sender: TObject; const SRC: String;
  81.       Loop: Integer; Terminate: Boolean);
  82.     procedure CopyImageToClipboardClick(Sender: TObject);
  83.     procedure ObjectClick(Sender, Obj: TObject; const OnClick: String);
  84.     procedure ViewimageClick(Sender: TObject);
  85.     procedure FormDestroy(Sender: TObject);
  86.     procedure ViewerInclude(Sender: TObject; const Command: String;
  87.       Params: TStrings; var Buffer: PChar; var BuffSize: Longint);
  88.     procedure RightClick(Sender: TObject;
  89.       Parameters: TRightClickParameters);
  90.     procedure OpenInNewWindowClick(Sender: TObject);
  91.     procedure MetaTimerTimer(Sender: TObject);
  92.     procedure MetaRefreshEvent(Sender: TObject; Delay: Integer;
  93.       const URL: String);
  94.     procedure Timer1Timer(Sender: TObject);
  95.     procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X,
  96.       Y: Integer);
  97.   private
  98.     { Private declarations }
  99.     Histories: array[0..MaxHistories-1] of TMenuItem;
  100.     MediaCount: integer;
  101.     FoundObject: TImageObj;
  102.     NewWindowFile: string;
  103.     MS: TMemoryStream;
  104.     NextFile, PresentFile: string;
  105.     TimerCount: integer;
  106.     OldObj: TObject;
  107.     HintWindow: THintWindow;
  108.  
  109.     {$ifdef Win32}
  110.     procedure wmDropFiles(var Message: TMessage); message wm_DropFiles;
  111.     {$endif}
  112.   public
  113.     { Public declarations }
  114.   end;
  115.  
  116. var
  117.   Form1: TForm1;
  118.  
  119. implementation
  120.  
  121. {$R *.DFM}
  122.  
  123. procedure TForm1.FormCreate(Sender: TObject);
  124. var
  125.   I: integer;
  126. begin
  127. Left := Left div 2;
  128. Top := Top div 2;
  129. Width := (Screen.Width * 8) div 10;
  130. Height := (Screen.Height * 3) div 4;
  131.  
  132. OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  133.  
  134. Caption := 'HTML Demo, Lite Version '+LiteAbt.Version;
  135.  
  136. ShowImages.Checked := Viewer.ViewImages;
  137. Viewer.HistoryMaxCount := MaxHistories;  {defines size of history list}
  138.  
  139. for I := 0 to MaxHistories-1 do
  140.   begin      {create the MenuItems for the history list}
  141.   Histories[I] := TMenuItem.Create(HistoryMenuItem);
  142.   HistoryMenuItem.Insert(I, Histories[I]);
  143.   with Histories[I] do
  144.     begin
  145.     Visible := False;
  146.     OnClick := HistoryClick;
  147.     Tag := I;
  148.     end;
  149.   end;
  150. {$ifdef Win32}
  151. DragAcceptFiles(Handle, True);
  152. {$endif}
  153. HintWindow := THintWindow.Create(Self);
  154. end;
  155.  
  156. {$ifdef Windows}
  157. procedure TForm1.FormShow(Sender: TObject);
  158. begin
  159. if (ParamCount >= 1) then
  160.   Viewer.LoadFromFile(ParamStr(1));  {Parameter is file to load}
  161. end;
  162.  
  163. {$else}
  164. procedure TForm1.FormShow(Sender: TObject);
  165. var
  166.   S: string;
  167.   I: integer;
  168. begin
  169. if (ParamCount >= 1) then
  170.   begin            {Parameter is file to load}
  171.   S := CmdLine;         
  172.   I := Pos('" ', S);
  173.   if I > 0 then
  174.     Delete(S, 1, I+1)     {delete EXE name in quotes}
  175.   else Delete(S, 1, Length(ParamStr(0)));  {in case no quote marks}
  176.   I := Pos('"', S);
  177.   while I > 0 do     {remove any quotes from parameter}
  178.     begin
  179.     Delete(S, I, 1);
  180.     I := Pos('"', S);
  181.     end;
  182.   Viewer.LoadFromFile(HtmlToDos(Trim(S)));
  183.   end;
  184. end;
  185. {$endif}
  186.  
  187. procedure TForm1.OpenFileClick(Sender: TObject);
  188. begin
  189. if Viewer.CurrentFile <> '' then
  190.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  191. if OpenDialog.Execute then
  192.   begin
  193.   Viewer.LoadFromFile(OpenDialog.Filename);
  194.   Caption := Viewer.DocumentTitle;
  195.   end;
  196. end;
  197.  
  198. procedure TForm1.HotSpotChange(Sender: TObject; const URL: string);
  199. {mouse moved over or away from a hot spot.  Change the status line}
  200. begin
  201. Panel1.Caption := URL;
  202. end;
  203.  
  204. procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
  205.           var Handled: boolean);
  206. {This routine handles what happens when a hot spot is clicked.  The assumption
  207.  is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are
  208.  handled here, but other file types could be easily added.
  209.  
  210.  If the URL is handled here, set Handled to True.  If not handled here, set it
  211.  to False and TLiteViewer will handle it.}
  212. const
  213.   snd_Async = $0001;  { play asynchronously }
  214. var
  215.   PC: array[0..255] of char;
  216.   S, Params: string[255];
  217.   Ext: string[5];
  218.   I, J, K: integer;
  219.   Tmp: String;
  220.  
  221. begin
  222. Handled := False;
  223. I := Pos(':', URL);
  224. J := Pos('FILE:', UpperCase(URL));
  225. if (I <= 2) or (J > 0) then
  226.   begin                      {apparently the URL is a filename}
  227.   S := URL;
  228.   K := Pos(' ', S);     {look for parameters}
  229.   if K = 0 then K := Pos('?', S);  {could be '?x,y' , etc}
  230.   if K > 0 then
  231.     begin
  232.     Params := Copy(S, K+1, 255); {save any parameters}
  233.     S[0] := chr(K-1);            {truncate S}
  234.     end
  235.   else Params := '';
  236.   S := Viewer.HTMLExpandFileName(S);
  237.   Ext := Uppercase(ExtractFileExt(S));
  238.   if Ext = '.WAV' then
  239.     begin
  240.     Handled := True;
  241.     sndPlaySound(StrPCopy(PC, S), snd_ASync);
  242.     end
  243.   else if Ext = '.EXE' then
  244.     begin
  245.     Handled := True;
  246.     WinExec(StrPCopy(PC, S+' '+Params), sw_Show);
  247.     end
  248.   else if (Ext = '.MID') or (Ext = '.AVI')  then
  249.     begin
  250.     Handled := True;
  251.     WinExec(StrPCopy(PC, 'MPlayer.exe /play /close '+S), sw_Show);
  252.     end;
  253.   {else ignore other extensions}
  254.   Edit1.Text := URL;
  255.   Exit;
  256.   end;
  257. I := Pos('MAILTO:', UpperCase(URL));
  258. J := Pos('HTTP:', UpperCase(URL));
  259. if (I > 0) or (J > 0) then
  260.   begin
  261.   Tmp := URL + #0;  {for Delphi 1}
  262.   {Note: ShellExecute causes problems when run from Delphi 4 IDE}
  263.   ShellExecute(0, nil, @Tmp[1], nil, nil, SW_SHOWNORMAL);
  264.   Handled := True;
  265.   Exit;
  266.   end;
  267. Edit1.Text := URL;   {other protocall}
  268. end;
  269.  
  270. procedure TForm1.ShowImagesClick(Sender: TObject);
  271. {The Show Images menu item was clicked}
  272. begin
  273. With Viewer do
  274.   begin
  275.   ViewImages := not ViewImages;
  276.   (Sender as TMenuItem).Checked := ViewImages;
  277.   end;
  278. end;
  279.  
  280. procedure TForm1.ReloadButtonClick(Sender: TObject);
  281. {the Reload button was clicked}
  282. begin
  283. with Viewer do
  284.   begin
  285.   ReLoadButton.Enabled := False;
  286.   ReLoad;
  287.   ReLoadButton.Enabled := CurrentFile <> '';
  288.   Viewer.SetFocus;
  289.   end;
  290. end;
  291.  
  292. procedure TForm1.FwdBackClick(Sender: TObject);
  293. {Either the Forward or Back button was clicked}
  294. begin
  295. with Viewer do
  296.   begin
  297.   if Sender = BackButton then
  298.     HistoryIndex := HistoryIndex +1
  299.   else
  300.     HistoryIndex := HistoryIndex -1;
  301.   Self.Caption := DocumentTitle;      
  302.   end;
  303. end;
  304.  
  305. procedure TForm1.HistoryChange(Sender: TObject);
  306. {This event occurs when something changes history list}
  307. var
  308.   I: integer;
  309.   Cap: string[80];
  310. begin
  311. with Sender as ThtmlLite do
  312.   begin
  313.   {check to see which buttons are to be enabled}
  314.   FwdButton.Enabled := HistoryIndex > 0;
  315.   BackButton.Enabled := HistoryIndex < History.Count-1;
  316.  
  317.   {Enable and caption the appropriate history menuitems}
  318.   HistoryMenuItem.Visible := History.Count > 0;
  319.   for I := 0 to MaxHistories-1 do
  320.     with Histories[I] do
  321.       if I < History.Count then
  322.         Begin
  323.         Cap := History.Strings[I];
  324.         if TitleHistory[I] <> '' then
  325.           Cap := Cap + '--' + TitleHistory[I];
  326.         Caption := Cap;    {Cap limits string to 80 char}
  327.         Visible := True;
  328.         Checked := I = HistoryIndex;
  329.         end
  330.       else Histories[I].Visible := False;
  331.   Caption := DocumentTitle;    {keep the caption updated}
  332.   Viewer.SetFocus;  
  333.   end;
  334. end;
  335.  
  336. procedure TForm1.HistoryClick(Sender: TObject);
  337. {A history list menuitem got clicked on}
  338. begin
  339.   {Changing the HistoryIndex loads and positions the appropriate document}
  340.   Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
  341. end;
  342.  
  343. procedure TForm1.Exit1Click(Sender: TObject);
  344. begin
  345. Close;
  346. end;
  347.  
  348. procedure TForm1.FontColorsClick(Sender: TObject);
  349. var
  350.   FontForm: TFontForm;
  351. begin
  352. FontForm := TFontForm.Create(Self);
  353. try
  354.   with FontForm do
  355.     begin
  356.     FontName := Viewer.DefFontName;
  357.     FontColor := Viewer.DefFontColor;
  358.     FontSize := Viewer.DefFontSize;
  359.     HotSpotColor := Viewer.DefHotSpotColor;
  360.     Background := Viewer.DefBackground;
  361.     if ShowModal = mrOK then
  362.       begin
  363.       Viewer.DefFontName := FontName;
  364.       Viewer.DefFontColor := FontColor;
  365.       Viewer.DefFontSize := FontSize;
  366.       Viewer.DefHotSpotColor := HotSpotColor;
  367.       Viewer.DefBackground := Background; 
  368.       ReloadButtonClick(Self);    {reload to see how it looks}
  369.       end;
  370.     end;
  371. finally
  372.   FontForm.Free;
  373.  end;
  374. end;   
  375.  
  376. procedure TForm1.About1Click(Sender: TObject);
  377. begin
  378. AboutBox := TAboutBox.CreateIt(Self);
  379. try
  380.   AboutBox.ShowModal;
  381. finally
  382.   AboutBox.Free;
  383.   end;
  384. end;
  385.  
  386.  
  387. procedure TForm1.SubmitEvent(Sender: TObject; const AnAction, Target, EncType, Method: String;
  388.   Results: TStringList);
  389. begin
  390. with SubmitForm do
  391.   begin
  392.   ActionText.Text := AnAction;
  393.   MethodText.Text := Method;
  394.   ResultBox.Items := Results;
  395.   Results.Free;
  396.   Show;
  397.   end;
  398. end;
  399.  
  400. procedure TForm1.Find1Click(Sender: TObject);
  401. begin
  402. FindDialog.Execute;
  403. end;
  404.  
  405. procedure TForm1.FindDialogFind(Sender: TObject);
  406. begin
  407. with FindDialog do
  408.   begin
  409.   if not Viewer.Find(FindText, frMatchCase in Options) then
  410.     MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0);
  411.   end;
  412. end;
  413.  
  414. procedure TForm1.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  415. begin
  416. if ProcessingOn then
  417.   begin    {disable various buttons and menuitems during processing}
  418.   FwdButton.Enabled := False;
  419.   BackButton.Enabled := False;
  420.   ReLoadButton.Enabled := False;
  421.   Find1.Enabled := False;
  422.   SelectAllItem.Enabled := False;
  423.   Open.Enabled := False;
  424.   end
  425. else
  426.   begin
  427.   FwdButton.Enabled := Viewer.HistoryIndex > 0;
  428.   BackButton.Enabled := Viewer.HistoryIndex < Viewer.History.Count-1;
  429.   ReLoadButton.Enabled := Viewer.CurrentFile <> '';
  430.   Find1.Enabled := Viewer.CurrentFile <> '';
  431.   SelectAllItem.Enabled := Viewer.CurrentFile <> '';
  432.   Open.Enabled := True;
  433.   end;
  434. end;
  435.  
  436. procedure TForm1.CopyItemClick(Sender: TObject);
  437. var
  438.   Rslt: word;
  439. begin
  440. Rslt := mrOK;
  441. if Viewer.SelLength > 32000 then
  442.   Rslt := MessageDlg('Selection exceeds buffer size and may be truncated',
  443.     mtWarning, [mbOK, mbCancel], 0);
  444. if Rslt = mrOK then Viewer.CopyToClipboard;
  445. end;
  446.  
  447. procedure TForm1.Edit2Click(Sender: TObject);
  448. begin
  449. CopyItem.Enabled := Viewer.SelLength > 0; 
  450. end;
  451.  
  452. procedure TForm1.SelectAllItemClick(Sender: TObject);
  453. begin
  454. Viewer.SelectAll;
  455. end;
  456.  
  457. procedure TForm1.OpenTextFileClick(Sender: TObject);
  458. begin
  459. if Viewer.CurrentFile <> '' then
  460.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  461. OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'+
  462.     '|Text Files (*.txt)|*.txt'+
  463.     '|All Files (*.*)|*.*';
  464. if OpenDialog.Execute then
  465.   begin
  466.   ReloadButton.Enabled := False;
  467.   Viewer.LoadTextFile(OpenDialog.Filename);
  468.   if Viewer.CurrentFile  <> '' then
  469.     begin
  470.     Caption := Viewer.DocumentTitle;
  471.     ReLoadButton.Enabled := True;
  472.     end;
  473.   end;
  474. end;
  475.  
  476. procedure TForm1.OpenImageFileClick(Sender: TObject);
  477. begin
  478. if Viewer.CurrentFile <> '' then
  479.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  480. OpenDialog.Filter := 'Graphics Files (*.bmp,*.gif,*.jpg,*.jpeg,*.png)|'+
  481.     '*.bmp;*.jpg;*.jpeg;*.gif;*.png|'+
  482.     'All Files (*.*)|*.*';
  483. if OpenDialog.Execute then
  484.   begin
  485.   ReloadButton.Enabled := False;
  486.   Viewer.LoadImageFile(OpenDialog.Filename);
  487.   if Viewer.CurrentFile  <> '' then
  488.     begin
  489.     Caption := Viewer.DocumentTitle;
  490.     ReLoadButton.Enabled := True;
  491.     end;
  492.   end;
  493. end;
  494.  
  495. {$ifdef Win32}
  496. procedure TForm1.wmDropFiles(var Message: TMessage);
  497. var
  498.   S: string[200];
  499.   Ext: string;
  500.   Count: integer;
  501. begin
  502. Count := DragQueryFile(Message.WParam, 0, @S[1], 200);
  503. Length(S) := Count;
  504. DragFinish(Message.WParam);
  505. if Count >0 then
  506.   begin
  507.   Ext := LowerCase(ExtractFileExt(S));
  508.   if (Ext = '.htm') or (Ext = '.html') then
  509.     Viewer.LoadFromFile(S)
  510.   else if (Ext = '.txt') then
  511.     Viewer.LoadTextFile(S)
  512.   else if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg')
  513.         or (Ext = '.jpeg') or (Ext = '.png') then
  514.     Viewer.LoadImageFile(S);
  515.   end;
  516. Message.Result := 0;
  517. end;
  518. {$endif}
  519.  
  520. procedure TForm1.MediaPlayerNotify(Sender: TObject);
  521. begin
  522. try
  523.   With MediaPlayer do
  524.     if NotifyValue = nvSuccessful then
  525.       begin
  526.       if MediaCount > 0 then
  527.         begin
  528.         Play;
  529.         Dec(MediaCount);
  530.         end
  531.       else
  532.         Close;
  533.       end;
  534. except
  535.   end;
  536. end;
  537.  
  538. procedure TForm1.SoundRequest(Sender: TObject; const SRC: String;
  539.   Loop: Integer; Terminate: Boolean);
  540. begin
  541. try
  542.   with MediaPlayer do
  543.     if Terminate then
  544.       Close
  545.     else
  546.       begin
  547.       Filename := (Sender as ThtmlLite).HTMLExpandFilename(SRC);
  548.       Notify := True;
  549.       Open;
  550.       if Loop < 0 then MediaCount := 9999
  551.         else if Loop = 0 then MediaCount := 1
  552.         else MediaCount := Loop;
  553.       end;
  554. except
  555.   end;
  556. end;
  557.  
  558. procedure TForm1.ViewimageClick(Sender: TObject);
  559. var
  560.   AForm: TImageForm;
  561. begin
  562. AForm := TImageForm.Create(Self);
  563. with AForm do
  564.   begin
  565.   ImageFormBitmap := FoundObject.Bitmap;
  566.   Caption := '';
  567.   Show;
  568.   end;
  569. end;
  570.  
  571. procedure TForm1.CopyImageToClipboardClick(Sender: TObject);
  572. begin
  573. Clipboard.Assign(FoundObject.Bitmap);
  574. end;
  575.  
  576. procedure TForm1.ObjectClick(Sender, Obj: TObject; const OnClick: String);
  577. var
  578.   S: string;
  579. begin
  580. if OnClick = 'display' then
  581.   begin
  582.   if Obj is TFormControlObj then
  583.     with TFormControlObj(Obj) do
  584.       begin
  585.       if TheControl is TCheckBox then
  586.         with TCheckBox(TheControl) do
  587.           begin
  588.           S := Value + ' is ';
  589.           if Checked then S := S + 'checked'
  590.             else S := S + 'unchecked';
  591.           MessageDlg(S, mtCustom, [mbOK], 0);
  592.           end
  593.       else if TheControl is TRadioButton then
  594.         with TRadioButton(TheControl) do
  595.           begin
  596.           S := Value + ' is checked';
  597.           MessageDlg(S, mtCustom, [mbOK], 0);
  598.           end;
  599.       end;
  600.   end
  601. else if OnClick <> '' then
  602.       MessageDlg(OnClick, mtCustom, [mbOK], 0);
  603. end;
  604.  
  605.  
  606. procedure TForm1.ViewerInclude(Sender: TObject; const Command: String;
  607.   Params: TStrings; var Buffer: PChar; var BuffSize: LongInt);
  608. {OnInclude handler}  
  609. const
  610.   S: string[255] = '';    {so will work in Delphi 1}
  611. var
  612.   Filename: string;
  613.   I: integer;
  614. begin
  615. BuffSize := 0;
  616. if CompareText(Command, 'Date') = 0 then
  617.   begin                { <!--#date --> }
  618.   S := DateToStr(Date);
  619.   Buffer := @S[1];
  620.   BuffSize := Length(S);
  621.   end
  622. else if CompareText(Command, 'Time') = 0 then
  623.   begin                { <!--#time -->  }
  624.   S := TimeToStr(Time);
  625.   Buffer := @S[1];
  626.   BuffSize := Length(S);
  627.   end
  628. else if CompareText(Command, 'Include') = 0 then
  629.   begin   {an include file <!--#include FILE="filename" -->  }
  630.   if (Params.count >= 1) then
  631.     begin
  632.     I := Pos('FILE="', Params[0]);
  633.     if I > 0 then
  634.       begin
  635.       Filename := copy(Params[0],  7, 255);
  636.       I := Pos('"', Filename);
  637.       if I > 0 then Delete(Filename, I, 255);
  638.       If MS = Nil then
  639.         MS := TMemoryStream.Create;
  640.       try
  641.         MS.LoadFromFile(Filename);
  642.         Buffer := MS.Memory;
  643.         BuffSize := MS.Size;
  644.       except
  645.         end;
  646.       end;
  647.     end;
  648.   end;
  649. Params.Free;
  650. end;
  651.  
  652. procedure TForm1.FormDestroy(Sender: TObject);
  653. begin
  654. MS.Free;
  655. HintWindow.Free;
  656. end;
  657.  
  658. procedure TForm1.RightClick(Sender: TObject; Parameters: TRightClickParameters);
  659. var
  660.   Pt: TPoint;
  661.   S, Dest: string;
  662.   I: integer;
  663.   HintWindow: THintWindow;
  664.   ARect: TRect;
  665. begin
  666. with Parameters do
  667.   begin
  668.   FoundObject := Image;
  669.   ViewImage.Enabled := (FoundObject <> Nil) and (FoundObject.Bitmap <> Nil);
  670.   CopyImageToClipboard.Enabled := (FoundObject <> Nil) and (FoundObject.Bitmap <> Nil);
  671.  
  672.   if URL <> '' then
  673.     begin
  674.     S := URL;
  675.     I := Pos('#', S);
  676.     if I >= 1 then
  677.       begin
  678.       Dest := System.Copy(S, I, 255);  {local destination}
  679.       S := System.Copy(S, 1, I-1);     {the file name}
  680.       end
  681.     else
  682.       Dest := '';    {no local destination}
  683.     if S = '' then S := Viewer.CurrentFile
  684.       else S := Viewer.HTMLExpandFileName(S);
  685.     NewWindowFile := S+Dest;
  686.     OpenInNewWindow.Enabled := FileExists(S);
  687.     end
  688.   else OpenInNewWindow.Enabled := False;
  689.  
  690.   GetCursorPos(Pt);
  691.   if Length(CLickWord) > 0 then
  692.     begin
  693.     HintWindow := THintWindow.Create(Self);
  694.     try
  695.       ARect := Rect(0,0,0,0);
  696.       DrawText(HintWindow.Canvas.Handle, @ClickWord[1], Length(ClickWord), ARect, DT_CALCRECT);
  697.       with ARect do
  698.         HintWindow.ActivateHint(Rect(Pt.X+20, Pt.Y-(Bottom-Top)-15, Pt.x+30+Right, Pt.Y-15), ClickWord);
  699.       PopupMenu.Popup(Pt.X, Pt.Y);
  700.     finally
  701.       HintWindow.Free;
  702.       end;
  703.     end
  704.   else PopupMenu.Popup(Pt.X, Pt.Y);
  705.   end;
  706. end;
  707.  
  708. procedure TForm1.OpenInNewWindowClick(Sender: TObject);
  709. var
  710.   PC: array[0..255] of char;
  711. begin
  712. {$ifdef Windows}
  713. WinExec(StrPCopy(PC, ParamStr(0)+' '+NewWindowFile), sw_Show);
  714. {$else}
  715. WinExec(StrPCopy(PC, ParamStr(0)+' "'+NewWindowFile+'"'), sw_Show);
  716. {$endif}
  717. end;
  718.  
  719. procedure TForm1.MetaTimerTimer(Sender: TObject);
  720. begin
  721. MetaTimer.Enabled := False;
  722. if Viewer.CurrentFile = PresentFile then  {don't load if current file has changed}
  723.   begin
  724.   Viewer.LoadFromFile(NextFile);
  725.   Caption := Viewer.DocumentTitle;
  726.   end;
  727. end;
  728.  
  729. procedure TForm1.MetaRefreshEvent(Sender: TObject; Delay: Integer;
  730.   const URL: String);
  731. begin
  732. NextFile := HTMLToDos(URL);
  733. if FileExists(NextFile) then
  734.   begin
  735.   PresentFile := Viewer.CurrentFile;
  736.   MetaTimer.Interval := Delay*1000;
  737.   MetaTimer.Enabled := True;
  738.   end;
  739. end;
  740.  
  741. procedure TForm1.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X,
  742.   Y: Integer);
  743. var
  744.   ObjX: TObject;
  745. begin
  746. if Viewer.PtInObject(X, Y, ObjX) then
  747.   begin
  748.   if (ObjX is TImageObj) and (ObjX <> OldObj) then
  749.     begin
  750.     if not Timer1.Enabled and (TImageObj(ObjX).Alt <>'') then
  751.       begin
  752.       TimerCount := 0;
  753.       Timer1.Enabled := True;
  754.       end;
  755.     end;
  756.   end
  757. else OldObj := Nil;
  758. end;
  759.  
  760. procedure TForm1.Timer1Timer(Sender: TObject);
  761. const
  762.   HintVisible: boolean = False;
  763. var
  764.   Pt, Pt1: TPoint;
  765.   ARect: TRect;
  766.   ObjX: TObject;
  767.  
  768.   procedure CloseAll;
  769.   begin
  770.   Timer1.Enabled := False;
  771.   HintWindow.ReleaseHandle;
  772.   HintVisible := False;
  773.   end;
  774.  
  775. begin
  776. Inc(TimerCount);
  777. GetCursorPos(Pt);
  778. Pt1 := Viewer.ScreenToClient(Pt);
  779. if not Viewer.PtInObject(Pt1.X, Pt1.Y, ObjX) then
  780.   begin
  781.   OldObj := Nil;
  782.   CloseAll;
  783.   Exit;
  784.   end;
  785. if TimerCount > 20 then
  786.   CloseAll
  787. else if (TimerCount >= 2) and ((not HintVisible) or (ObjX <> OldObj)) then
  788.   if (ObjX is TImageObj) then
  789.     with TImageObj(ObjX) do
  790.       if Alt <> '' then
  791.         begin
  792.         {$ifdef ver90}  {Delphi 2}
  793.         ARect := Rect(0,0,0,0);
  794.         DrawText(HintWindow.Canvas.Handle, @Alt[1], Length(Alt), ARect, DT_CALCRECT);
  795.         {$else}
  796.         ARect := HintWindow.CalcHintRect(300, Alt, Nil);
  797.         {$endif}
  798.         with ARect do
  799.           HintWindow.ActivateHint(Rect(Pt.X, Pt.Y+18, Pt.X+Right, Pt.Y+18+Bottom), Alt);
  800.         HintVisible := True;
  801.         if OldObj <> ObjX then
  802.           begin
  803.           TimerCount := 2;  {reset to full On count}
  804.           OldObj := ObjX;
  805.           end;
  806.         end
  807.       else CloseAll;
  808. end;
  809.  
  810. end.
  811.